home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2.0 - Programmer's Utilities Power Pack / Delphi 2.0 Programmer's Utilities Power Pack.iso / e_to_l / hlpcloud / unit1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  5.3 KB  |  233 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.    SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.    Forms, Dialogs, StdCtrls, ExtCtrls, HlpCloud, TileBack, Buttons,
  8.    Expedit, Prompt, Buttonex;
  9.  
  10. type
  11.    TForm1 = class(TForm)
  12.          Panel1        : TPanel;
  13.          Panel2        : TPanel;
  14.          PromptExt1    : TPromptExt;
  15.          ExpandEdit1   : TExpandEdit;
  16.          BitBtn1       : TBitBtn;
  17.          BitBtn2       : TBitBtn;
  18.          BitBtn3       : TBitBtn;
  19.          BitBtn4       : TBitBtn;
  20.          BitBtn6       : TBitBtn;
  21.          BitBtn7       : TBitBtn;
  22.          RadioButton1  : TRadioButton;
  23.          RadioButton2  : TRadioButton;
  24.          FD            : TFontDialog;
  25.          Edit1         : TEdit;
  26.     TileBack1: TTileBack;
  27.     RadioButton3: TRadioButton;
  28.     RadioButton4: TRadioButton;
  29.     RadioButton5: TRadioButton;
  30.     RadioButton6: TRadioButton;
  31.     RadioButton7: TRadioButton;
  32.     ButtonExt1: TButtonExt;
  33.     HelpCloud1: THelpCloud;
  34.  
  35.          procedure BitBtn3Click(Sender: TObject);
  36.          procedure BitBtn4Click(Sender: TObject);
  37.          procedure RadioButton1Click(Sender: TObject);
  38.          procedure RadioButton2Click(Sender: TObject);
  39.          procedure RadioButton7Click(Sender: TObject);
  40.          procedure RadioButton5Click(Sender: TObject);
  41.          procedure RadioButton3Click(Sender: TObject);
  42.          procedure RadioButton4Click(Sender: TObject);
  43.          procedure RadioButton6Click(Sender: TObject);
  44.          procedure BitBtn7Click(Sender: TObject);
  45.          procedure FormClose(Sender: TObject; var Action: TCloseAction);
  46.     procedure HelpCloud1SetHintRect(Sender: TObject; memCanvas: TCanvas;
  47.       var Rect: TRect; Hint: String; drawCorner: THelpCloudCorner);
  48.     procedure HelpCloud1SetWinSize(Sender: TObject; memCanvas: TCanvas;
  49.       var Width, Height: Integer; Hint: String;
  50.       drawCorner: THelpCloudCorner);
  51.          
  52.       private
  53.  
  54.       public
  55.  
  56.         constructor Create(AOwner: TComponent); override;
  57.         destructor Destroy;
  58.                                        
  59.    end;  { TForm1 }
  60.  
  61. var Form1 : TForm1;
  62.  
  63. implementation
  64.  
  65. {$R *.DFM}
  66.  
  67. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  68. begin
  69.   Action := caFree;
  70. end;
  71.  
  72. constructor TForm1.Create(AOwner: TComponent);
  73. begin
  74.    inherited Create( AOwner );
  75.  
  76.    HelpCloud1.Style := Standard;
  77.    Edit1.Text       := HelpCloud1.Font.Name;
  78.                  
  79. end;
  80.  
  81. destructor TForm1.Destroy;
  82. begin
  83.    HelpCloud1.Style              := Standard;
  84.    HelpCloud1.Bitmaps.UpperRight := nil;
  85.    HelpCloud1.Alignment          := taCenter;
  86.  
  87.    inherited Destroy;
  88. end;
  89.  
  90. procedure TForm1.BitBtn3Click(Sender: TObject);
  91. begin
  92.    HelpCloud1.Color := clYellow;
  93. end;
  94.  
  95. procedure TForm1.BitBtn4Click(Sender: TObject);
  96. begin
  97.    HelpCloud1.Font.Name := 'New Times Roman';
  98.    HelpCloud1.Font.Size := 12;
  99.    Edit1.Text           := HelpCloud1.Font.Name;
  100. end;               
  101.  
  102. procedure TForm1.RadioButton1Click(Sender: TObject);
  103. begin
  104.    HelpCloud1.Style := Standard;
  105.    HelpCloud1.Bitmaps.UpperRight := nil;
  106. end;
  107.  
  108. procedure TForm1.RadioButton2Click(Sender: TObject);
  109. begin
  110.    HelpCloud1.Style := Bubble;
  111.    HelpCloud1.Bitmaps.UpperRight := nil;
  112. end;                                    
  113.  
  114. procedure TForm1.RadioButton7Click(Sender: TObject);
  115. begin
  116.    HelpCloud1.Bitmaps.UpperRight := ButtonExt1.Bitmaps.up;
  117.    HelpCloud1.Bitmaps.TransparentColor := ButtonExt1.Bitmaps.TransparentColor;
  118. end;
  119.  
  120. procedure TForm1.RadioButton5Click(Sender: TObject);
  121. begin
  122.    HelpCloud1.Corner := LowerLeft;
  123. end;
  124.  
  125.  
  126. procedure TForm1.RadioButton3Click(Sender: TObject);
  127. begin
  128.    HelpCloud1.Corner := UpperLeft;
  129. end;
  130.  
  131. procedure TForm1.RadioButton4Click(Sender: TObject);
  132. begin
  133.    HelpCloud1.Corner := UpperRight;
  134. end;
  135.  
  136. procedure TForm1.RadioButton6Click(Sender: TObject);
  137. begin
  138.    HelpCloud1.Corner := LowerRight;
  139. end;
  140.  
  141. procedure TForm1.BitBtn7Click(Sender: TObject);
  142. begin
  143.    if (FD.Execute) then
  144.     begin
  145.       HelpCloud1.Font := FD.Font;
  146.       Edit1.Text      := FD.Font.Name;
  147.     end;
  148. end;
  149.  
  150. procedure TForm1.HelpCloud1SetHintRect(Sender: TObject;
  151.   memCanvas: TCanvas; var Rect: TRect; Hint: String;
  152.   drawCorner: THelpCloudCorner);
  153. var
  154.    fwidth  : integer;
  155.    fheight : integer;
  156.    bRect   : TRect;
  157.    CHint   : array [0..255] of char;
  158.  
  159. begin
  160.    { Try and make the text rect as square as possible }
  161.  
  162.    fwidth  := memCanvas.TextWidth( Hint );
  163.    fheight := memCanvas.TextHeight( Hint );
  164.  
  165.    if (fWidth > 50) then
  166.       fwidth  := trunc( sqrt( fWidth * fheight ) +25)
  167.    else
  168.       fWidth  := 50;
  169.  
  170.    bRect   := Bounds( 0, 0, fWidth, 0 );
  171.  
  172.    DrawText( memCanvas.Handle,
  173.              StrPCopy( CHint, hint ),
  174.              -1,
  175.              bRect,
  176.              DT_CALCRECT or DT_LEFT or DT_WORDBREAK or DT_NOPREFIX);
  177.  
  178.    InflateRect( bRect, 5, 5);
  179.  
  180.    if ((bRect.Right - bRect.Left) < 40) then
  181.       bRect := Bounds( bRect.Left, bRect.Top, 40, bRect.Bottom - bRect.Top );
  182.   
  183.    OffsetRect( bRect, rect.left+10, rect.top+10 );
  184.  
  185.    rect := bRect;
  186.  
  187. end;
  188.  
  189. procedure TForm1.HelpCloud1SetWinSize(Sender: TObject;
  190.   memCanvas: TCanvas; var Width, Height: Integer; Hint: String;
  191.   drawCorner: THelpCloudCorner);
  192. begin
  193.    Width := Width + 5;
  194.    Height := Height + 5;
  195. end;
  196.  
  197. end.
  198.  
  199.  
  200.  
  201.  
  202.  
  203.  
  204.  
  205.  
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  
  224.  
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.                      
  232.  
  233.